Tricks of the Mac Game Programming Gurus/TricksOfTheMacGameProgrammingGurus.iso/More Source/Pascal/PWarp/Warp.p

Text File | 1995-03-29 | 5KB | 214 lines

program Pwarp;

{Based on Warp by Tony Mattis}

{Changes:}
{• different colors on the stars}
{• scaled sizes}
{• works even without CQD}

{$IFC UNDEFINED THINK_PASCAL}
        uses Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit,{} TextEdit, Traps, Desk, Memory,{}
        SegLoad, Scrap, ToolUtils, OSEvents, OSUtils, Menus, Resources, Packages; {}
{$ENDC}

    const
        kNumOfStars = 30;    {was 70}
        kProjDistance = 150; {was 450}
        kLargeStar = 0;
        kSmallStar = 1;
        kVelocity = 6;

    type
        Star = record
                x, y, z: Longint;            {3D location}
                size: Integer;                {How big?}
                starColor: RGBColor;    {Draw in this color}
                location: Point;            {Screen location}
            end;

    var
        gStarField: array[0..kNumOfStars] of Star;
        gOrigin: Point;
        gWindow: WindowPtr;
        gColorFlag: Boolean;
gScreenRect:Rect;
    procedure InitToolbox;
        var
            theWorld: SysEnvRec;
    begin
{$IFC UNDEFINED THINK_PASCAL}
        InitGraf(@qd.thePort);
        InitFonts;
        InitWindows;
        InitMenus;
        TEInit;
        InitDialogs(nil);
        qd.randSeed := TickCount;
        gScreenRect := qd.screenBits.bounds;
{$ELSEC}
        randSeed := TickCount;
        gScreenRect := screenBits.bounds;
{$ENDC}
        InitCursor;

        if noErr = SysEnvirons(1, theWorld) then
            gColorFlag := theWorld.hasColorQD;

        if gColorFlag then
            gWindow := NewCWindow(nil, gScreenRect, '', true, plainDBox, WindowPtr(-1), false, 0)
        else
            gWindow := NewWindow(nil, gScreenRect, '', true, plainDBox, WindowPtr(-1), false, 0);

{Make the window cover the entire screen}
        RectRgn(gWindow^.visRgn, gScreenRect);

        SetPort(gWindow);
        PaintRect(gWindow^.portRect);
    end;

    function GetRandom (min: Integer; max: Integer): Integer;
    begin
        GetRandom := abs(Random) mod (max - min + 1) + min;
    end; {GetRandom}

    procedure CreateStar (var aStar: Star);
    begin
        aStar.x := GetRandom(0, gOrigin.h) - gOrigin.h div 2;
        aStar.y := GetRandom(0, gOrigin.v) - gOrigin.v div 2;
        aStar.z := GetRandom(0, 150) + 125;

        aStar.size := GetRandom(0, 1);

        if gColorFlag then
            begin
                aStar.starColor.red := Random;
                aStar.starColor.green := Random;
                aStar.starColor.blue := Random;

{Set one component to max so all stars are bright}
                case GetRandom(1, 3) of
                    1:
                        aStar.starColor.red := -1;
                    2:
                        aStar.starColor.green := -1;
                    3:
                        aStar.starColor.blue := -1;
                end; {case}
            end;

    end; {CreateStar}

    procedure WarpColor (starColor: RGBColor);
    begin
        if gColorFlag then
            RGBForeColor(starColor)
        else
            ForeColor(whiteColor);
    end; {WarpColor}

    procedure InitStarField;
        var
            loop: Integer;
    begin
        gOrigin.h := (gScreenRect.right - gScreenRect.left) div 2;
        gOrigin.v := (gScreenRect.bottom - gScreenRect.top) div 2;

        for loop := 0 to kNumOfStars - 1 do
            CreateStar(gStarField[loop]);
    end; {InitStarField}

    procedure DrawLargeStar (aStar: Star);
        var
            starRect: Rect;
            starSize: Integer;
        const
            kStarScale = 300;
            kViewBase = 5;
    begin
        starSize := 1 + kStarScale div (aStar.z + kViewBase);
        starRect.left := aStar.location.h;
        starRect.right := starRect.left + starSize;
        starRect.top := aStar.location.v;
        starRect.bottom := starRect.top + starSize;

        PaintOval(starRect);
    end; {DrawLargeStar}

    procedure DrawSmallStar (aPt: Point);
    begin
        MoveTo(aPt.h, aPt.v);
        LineTo(aPt.h, aPt.v);
    end;

{Make a projection from 3D space to the screen}
    function Project (aStar: Star): Point;
        var
            starRect: Point;
    begin
        starRect.h := aStar.x * kProjDistance div aStar.z + gOrigin.h;
        starRect.v := aStar.y * kProjDistance div aStar.z + gOrigin.v;

        Project := starRect;
    end; {Project}

{Move a star, reset it if necessary}
    procedure AnimateStar (var aStar: Star);
    begin
        aStar.z := aStar.z - kVelocity;
        if aStar.z <= 0 then
            CreateStar(aStar);

        aStar.location := Project(aStar);

        if aStar.location.h < 0 then
            CreateStar(aStar)
        else if aStar.location.h > gScreenRect.right then
            CreateStar(aStar)
        else if aStar.location.v > gScreenRect.bottom then
            CreateStar(aStar)
        else if aStar.location.v < 0 then
            CreateStar(aStar);
    end; {AnimateStar}

    procedure AnimateStarField;
        var
            loop: Integer;
    begin
        for loop := 0 to kNumOfStars - 1 do
            begin
                ForeColor(blackColor);
                if gStarField[loop].size = kLargeStar then
                    DrawLargeStar(gStarField[loop])
                else
                    DrawSmallStar(gStarField[loop].location);

                AnimateStar(gStarField[loop]);
                WarpColor(gStarField[loop].starColor);

                if gStarField[loop].size = kLargeStar then
                    DrawLargeStar(gStarField[loop])
                else
                    DrawSmallStar(gStarField[loop].location);
            end;
    end; {AnimateStarField}

    var
        startTime: Longint;

begin {main program}
    InitToolbox;
    InitStarField;
    HideCursor;

    while not Button do
        begin
            startTime := TickCount;
            AnimateStarField;
            while TickCount < startTime + 1 do
                ;
        end;

    ShowCursor;

end. {main program}